home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_gen / t4diblib.zip / ANIMATE4.F3_ / ANIMATE4.F3
Text File  |  1995-11-14  |  3KB  |  116 lines
  1. VERSION 2.00
  2. Begin Form Form1
  3.    Caption         =   "ANIMATE4"
  4.    ClientHeight    =   1896
  5.    ClientLeft      =   2628
  6.    ClientTop       =   2688
  7.    ClientWidth     =   2988
  8.    Height          =   2316
  9.    Left            =   2580
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   1896
  12.    ScaleWidth      =   2988
  13.    Top             =   2316
  14.    Width           =   3084
  15.    Begin T4DILIB dilib2
  16.       Caption         =   "dilib2"
  17.       ControlMode     =   1  'Lib -> DIB
  18.       Height          =   384
  19.       Left            =   1680
  20.       Top             =   720
  21.       Visible         =   0   'False
  22.       Width           =   972
  23.    End
  24.    Begin T4DILIB dilib3
  25.       Caption         =   "dilib3"
  26.       ControlMode     =   3  'DIB -> PIC
  27.       Height          =   372
  28.       Left            =   1680
  29.       Top             =   1200
  30.       Visible         =   0   'False
  31.       Width           =   972
  32.    End
  33.    Begin CommandButton Command1
  34.       Caption         =   "&Quit"
  35.       Height          =   372
  36.       Left            =   120
  37.       TabIndex        =   0
  38.       Top             =   1200
  39.       Width           =   1452
  40.    End
  41.    Begin Image Image1
  42.       Height          =   372
  43.       Left            =   120
  44.       Stretch         =   -1  'True
  45.       Top             =   120
  46.       Width           =   372
  47.    End
  48. End
  49. Option Explicit
  50. Declare Function GlobalFree% Lib "kernel" (ByVal h%)
  51. Declare Function GetFreeSpace& Lib "kernel" (ByVal x%)
  52. Dim TimeIn!
  53. Dim Frames%
  54.  
  55. Sub Command1_Click ()
  56.  Terminate
  57. End Sub
  58.  
  59. Sub Form_Load ()
  60. Dim loopctr%, memctr%
  61. Dim imwidth!, imheight!, imhwratio!
  62. Dim memret%, hDib%
  63.  Top = (screen.Height - Height) / 2!
  64.  Left = (screen.Width - Width) / 2!
  65.  dilib2.LibraryName = "bluespin.ilb"
  66.  dilib2.Action = IM_ACTION_OPENLIBRARY
  67.  Show
  68.  hDib = 0 'Safety pays
  69.  Frames = 0
  70.  TimeIn = Timer
  71.  For loopctr = 1 To 100
  72.   For memctr = 1 To dilib2.MemberCount
  73.    'Disregard these comments for tutorial.
  74.    'Moving image
  75.    'image1.Left = image1.Left + screen.TwipsPerPixelX
  76.    'image1.Top = image1.Top + screen.TwipsPerPixelY
  77.    dilib2.MemberNumber = memctr
  78.    imwidth = dilib2.PixelWidth
  79.    imheight = dilib2.PixelHeight
  80.    imhwratio = imheight / imwidth
  81.    image1.Height = imhwratio * image1.Width
  82. 'If we have an hDib from a previous call, free it.
  83.    If hDib <> 0 Then
  84.     memret = GlobalFree(hDib)
  85.    End If
  86. 'Get the DIB from the library
  87.    dilib2.Action = IM_ACTION_GETMEMBER
  88. 'Save the hDib for freeing later.
  89.    hDib = dilib2.hDib
  90. 'Send the hDib to dilib3 for transformation.
  91.    dilib3.hDib = hDib
  92. 'Put the PIC in image1.
  93.    image1.Picture = dilib3.Picture
  94.    image1.Refresh
  95.    Frames = Frames + 1
  96.   Next memctr
  97.   DoEvents
  98.  Next loopctr
  99.  Terminate
  100. End Sub
  101.  
  102. Sub Form_Unload (Cancel As Integer)
  103.  End
  104. End Sub
  105.  
  106. Sub Terminate ()
  107. Dim TimeOut!, TimeElapsed!, fps!
  108.  TimeOut = Timer
  109.  TimeElapsed = TimeOut - TimeIn
  110.  fps = Frames
  111.  fps = Frames / TimeElapsed
  112.  MsgBox Trim$(Str$(fps)) + " frames per second."
  113.  End
  114. End Sub
  115.  
  116.